io Programmo 37/IOPROG_37.ISO/SOFT/Multilizer.exe/disk1/data1.cab/data1/[Group9]VCL Source Standard/ivwreader.pas

Pascal/Delphi Source File | 1999-08-12 | 6.8 KB | 330 lines

unit IvWReader;

{$I IVMULTI.INC}

interface

uses
{$IFDEF WIN32}
  Windows,
{$ELSE}
  WinTypes, WinProcs,
{$ENDIF}
  SysUtils, IvDictio, IvReader;

const
  WIDE_TAB_C: WideChar = WideChar($0009);
  WIDE_LF_C: WideChar = WideChar($000A);
  WIDE_CR_C: WideChar = WideChar($000D);
  UTF16LE_TAG_C: WideChar = WideChar($FEFF);
  UTF16BE_TAG_C: WideChar = WideChar($FFFE);

type
  EIvNotUnicodeFile = class(Exception);

  TIvBaseWideReader = class(TObject)
  protected
    FStorageName: String;

  public
    procedure Open; virtual; abstract;

    function Eof: Boolean; virtual; abstract;
    function ReadLine: TIvWideString; virtual; abstract;

    property StorageName: String read FStorageName write FStorageName;
  end;

  TIvWideReader = class(TIvBaseWideReader)
  protected
    FHandle: Integer;
    FBufferSize: Integer;
    FBufferIndex: Integer;
    FBuffer: array[0..255] of WideChar;
    FByteOrder: TIvByteOrder;

    function ReadIntoBuffer: Integer;
    procedure ChangeWordByteOrder(var value: WideChar);

  public
    constructor Create;
    destructor Destroy; override;

    procedure Open; override;
    procedure Close;

    function Eof: Boolean; override;
    function ReadLine: TIvWideString; override;

    property ByteOrder: TIvByteOrder read FByteOrder;
  end;

  TIvResourceWideReader = class(TIvBaseWideReader)
  protected
    FBuffer: PWideChar;
    FBufferIndex: Integer;
    FBufferSize: Integer;

  public
    constructor Create;

    procedure Open; override;
    function Eof: Boolean; override;
    function ReadLine: TIvWideString; override;
  end;

implementation

constructor TIvWideReader.Create;
begin
  inherited Create;
  FHandle := 0;
  FByteOrder := ivboLittleEndian;
end;

destructor TIvWideReader.Destroy;
begin
  Close;
  inherited Destroy;
end;

procedure TIvWideReader.ChangeWordByteOrder(var value: WideChar);
begin
  value :=
    WideChar(((Word(value) and $00FF) shl 8) or
    ((Word(value) and $FF00) shr 8));
end;

function TIvWideReader.ReadIntoBuffer: Integer;
begin
  FBufferIndex := 0;
  FBufferSize := FileRead(FHandle, FBuffer, SizeOf(FBuffer)) div SizeOf(WideChar);
  Result := FBufferSize;
end;

procedure TIvWideReader.Open;
var
  c: WideChar;
begin
  FHandle := FileOpen(FStorageName, fmOpenRead);
  if FHandle <= 0 then
    raise EInOutError.Create('Could not open the file ' + FStorageName);

  if (FileRead(FHandle, c, SizeOf(c)) < SizeOf(c)) or ((c <> UTF16LE_TAG_C) and ((c <> UTF16BE_TAG_C))) then
  begin
    FileClose(FHandle);
    raise EIvNotUnicodeFile.Create('Not a Unicode file');
  end
  else if c = UTF16LE_TAG_C then
    FByteOrder := ivboLittleEndian
  else
    FByteOrder := ivboBigEndian;

  FBufferIndex := 0;
  FBufferSize := 0;
end;

procedure TIvWideReader.Close;
begin
  if FHandle > 0 then
  begin
    FileClose(FHandle);
    FHandle := 0;
    FBufferIndex := 0;
    FBufferSize := 0;
  end;
end;

function TIvWideReader.Eof: Boolean;
begin
  if (FBufferSize = 0) or (FBufferIndex = FBufferSize) then
    ReadIntoBuffer;
  Result := FBufferSize = 0;
end;

{$IFDEF IVWIDE}
function TIvWideReader.ReadLine: WideString;
var
  c: WideChar;
begin
  Result := '';
  while True do
  begin
    if FBufferIndex = FBufferSize then
    begin
      if ReadIntoBuffer = 0 then
        Break;
    end;

    c := FBuffer[FBufferIndex];
    if ByteOrder = ivboBigEndian then
      ChangeWordByteOrder(c);
    Inc(FBufferIndex);

    if c = WIDE_LF_C then
      // Unix style text file (only LF at the end of line)

      Break
    else if c = WIDE_CR_C then
    begin
      // MSDOS style text file (both CR and LF at the end of line)

      if FBufferIndex = FBufferSize then
      begin
        if ReadIntoBuffer = 0 then
          Break;
      end;

      Inc(FBufferIndex);
      Break;
    end
    else
      Result := Result + WideString(c);
  end;
end;
{$ELSE}
function TIvWideReader.ReadLine: TIvWideString;
var
  c: WideChar;
  len, size: Integer;
begin
  len := 0;
  size := 256;
  Result := SysAllocStringLen(nil, size);
  while True do
  begin
    if FBufferIndex = FBufferSize then
    begin
      if ReadIntoBuffer = 0 then
        Break;
    end;

    c := FBuffer[FBufferIndex];
    if ByteOrder = ivboBigEndian then
      ChangeWordByteOrder(c);
    Inc(FBufferIndex);

    if c = WIDE_LF_C then
      // Unix style text file (only LF at the end of line)

      Break
    else if c = WIDE_CR_C then
    begin
      if FBufferIndex = FBufferSize then
      begin
        if ReadIntoBuffer = 0 then
          Break;
      end;

      Inc(FBufferIndex);
      Break;
    end
    else
    begin
      if len >= size then
      begin
        size := 3*size div 2;
        SysReAllocStringLen(Result, Result, size);
      end;
      Result[len] := c;
      Inc(len);
    end;
  end;
  Result[len] := WideChar(0);
end;
{$ENDIF}

constructor TIvResourceWideReader.Create;
begin
  inherited Create;
  FBuffer := nil;
  FBufferIndex := 0;
  FBufferSize := 0;
end;

procedure TIvResourceWideReader.Open;
var
  resource: HRSRC;
  handle: HGLOBAL;
begin
  resource := FindResource(HInstance, PChar(FStorageName), MULTILIZER_RES_TYPE_C);
  if resource = 0 then
    raise EInOutError.Create('Could not open the resource ' + FStorageName);

  handle := LoadResource(HInstance, resource);
  if handle = 0 then
    raise EInOutError.Create('Could not open the resource ' + FStorageName);

  FBuffer := LockResource(handle);
  FBufferIndex := 0;
  FBufferSize := SizeofResource(HInstance, resource);
end;

function TIvResourceWideReader.Eof: Boolean;
begin
  Result := FBufferIndex = FBufferSize;
end;

{$IFDEF IVWIDE}
function TIvResourceWideReader.ReadLine: WideString;
var
  c: WideChar;
begin
  Result := '';
  while True do
  begin
    c := FBuffer[FBufferIndex];
    Inc(FBufferIndex);

    if c = WIDE_LF_C then
      // Unix style text file (only LF at the end of line)

      Break
    else if c = WIDE_CR_C then
    begin
      Inc(FBufferIndex);
      Break;
    end
    else
      Result := Result + WideString(c);
  end;
end;
{$ELSE}
function TIvResourceWideReader.ReadLine: TIvWideString;
var
  c: WideChar;
  len, size: Integer;
begin
  len := 0;
  size := 256;
  Result := SysAllocStringLen(nil, size);
  while True do
  begin
    c := FBuffer[FBufferIndex];
    Inc(FBufferIndex);

    if c = WIDE_LF_C then
      // Unix style text file (only LF at the end of line)

      Break
    else if c = WIDE_CR_C then
    begin
      Inc(FBufferIndex);
      Break;
    end
    else
    begin
      if len >= size then
      begin
        size := 3*size div 2;
        SysReAllocStringLen(Result, Result, size);
      end;
      Result[len] := c;
      Inc(len);
    end;
  end;
end;
{$ENDIF}

end.